home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lisp / qprolog.el < prev    next >
Encoding:
Text File  |  1992-05-26  |  4.6 KB  |  157 lines
  1. ;;;  SCCS: @(#)90/12/12 qprolog.el    2.3
  2. ;;;            Quintus Prolog - GNU Emacs Interface
  3. ;;;                         Support Functions
  4. ;;;
  5. ;;;                Consolidated by Sitaram Muralidhar
  6. ;;;
  7. ;;;                   sitaram@quintus.com
  8. ;;;              Quintus Computer Systems, Inc.
  9. ;;;                  2 May 1989       
  10. ;;;
  11. ;;; This file defines functions that support the Quintus Prolog - GNU Emacs
  12. ;;; interface.
  13. ;;;
  14. ;;;                   Acknowledgements
  15. ;;;
  16. ;;;
  17. ;;; This interface was made possible by contributions from Fernando
  18. ;;; Pereira and various customers of Quintus Computer Systems, Inc.,
  19. ;;; based on code for Quintus's Unipress Emacs interface.
  20. ;;; Functions for moving around a prolog source buffer
  21.  
  22. (provide 'prolog)
  23. (defmacro first-line ()
  24.   (save-excursion (beginning-of-line) (bobp)))
  25.  
  26. (defmacro last-line ()
  27.   (save-excursion (end-of-line) (eobp)))
  28.  
  29. (defun skip-prolog-comment (range)
  30.   (let ((current-location (point)))
  31.   (if (save-excursion 
  32.     (beginning-of-line)
  33.     (search-forward "%" current-location t))
  34.       (progn (skip-prolog-%-comment range) t)
  35.     (not (skip-prolog-/*-*/-comment range)))))
  36.  
  37. (defun skip-prolog-%-comment (range)
  38.   "Skip to the beginning or end of a prolog comment depending
  39. on if the range is before or after the point in"
  40.   (let* ((forward (> (point) range))
  41.      (line-skip (if forward -1 1))
  42.      (in-comment t))
  43.     (while (and in-comment (not (bobp)) (not (eobp)))
  44.       (previous-line line-skip)
  45.       (beginning-of-line)
  46.       (setq in-comment (= (following-char) ?%)))))
  47.  
  48. (defun skip-prolog-/*-*/-comment (range)
  49. "Skip to the beginning or end of a prolog comment depending
  50. on if the range is before or after the point"
  51.   (let* ((current-point (point))
  52.          (forward (> current-point range)))
  53.       (if forward
  54.       (if (search-backward "\/*" range t)
  55.           (not (search-forward "*\/"))
  56.         t)
  57.     (if (search-forward "*\/" range t)
  58.         (not (search-backward "\/*"))
  59.       t))))
  60.  
  61.  
  62. (defun beginning-of-clause (&optional arg)
  63.   "Move backward to next beginning-of-clause.
  64. With argument, do this that many times.
  65. Returns t unless search stops due to end of buffer."
  66.   (interactive "p")
  67.   (and arg (< arg 0) (forward-char 1))
  68.   (let ((clause-point (point)) (not-done t) (command-point (point)))
  69.     (while (and not-done (not (bobp)))
  70.       (if (and arg (< arg 0))
  71.       (skip-chars-forward " \t\n")
  72.       (skip-chars-backward " \t\n"))
  73.       (if (re-search-backward "^\\S-" nil 'move (or arg 1))
  74.       (if (= (following-char) ?%)
  75.           (skip-prolog-%-comment clause-point)
  76.         (setq not-done (not (skip-prolog-/*-*/-comment clause-point)))))
  77.       (setq clause-point (point)))
  78.     )
  79.   )
  80.  
  81. (defun end-of-clause (&optional arg)
  82.   "Move forward to next end of prolog clause."
  83.   (interactive "p")
  84.   (and arg (< arg 0) (forward-char 1))
  85.   (let ((clause-point (point)) (not-done t) (command-point (point)))
  86.     (while (and not-done (not (eobp)))
  87.       (re-search-forward "[^.]\\.\\(\\s-\\)*$" nil 'move (or arg 1))
  88.       (setq not-done (skip-prolog-comment clause-point))
  89.       (setq clause-point (point)))
  90.     (if not-done (progn (goto-char command-point) (beep)))))
  91.  
  92. (defun mark-clause ()
  93.   (interactive)
  94.   (end-of-clause)
  95.   (set-mark (point))
  96.   (beginning-of-clause)
  97.   (message "Clause marked")
  98. )
  99.  
  100. (defun kill-clause ()
  101. "Kill the prolog clause that the point in currently in"
  102.   (interactive)
  103.   (mark-clause)
  104.   (kill-region (point) (mark)))
  105.  
  106. (defun insert-rcs-header ()
  107.   (interactive)
  108.   (save-excursion
  109.     (goto-char (point-min))
  110.     (insert-string *rcs-header*)
  111.     ))
  112.  
  113. (defvar *rcs-header*
  114. "/*
  115.    $Author: jan $
  116.    $Date: 1992/05/26 11:51:43 $
  117.    $Revision: 1.1.1.1 $
  118.    $Log: qprolog.el,v $
  119.    Revision 1.1.1.1  1992/05/26 11:51:43  jan
  120.    Initial CVS
  121.  
  122. ; Revision 1.1.1.1  1992/05/25  18:50:48  jan
  123. ; Initial cvs version
  124. ;
  125. */
  126. :- add_rcsid(
  127.         '$Source: /staff/jan/CVS/pl/lisp/qprolog.el,v $',
  128.         '$Header: /staff/jan/CVS/pl/lisp/qprolog.el,v 1.1.1.1 1992/05/26 11:51:43 jan Exp $'
  129.         ).
  130. "
  131. )
  132.  
  133. (defun check-for-module-change (start end) 
  134.   (save-excursion
  135.     (goto-char start)
  136.     (if (looking-at " *module(\\(.*\\))")
  137.     (let ((module-name (buffer-substring (match-beginning 1) (match-end 1)))
  138.           (module-elm (assq 'prolog-module minor-mode-alist)))
  139.       (message "Switching to module %s" module-name)
  140.       (setq mode-name (concat "Inferior Prolog: " module-name))
  141.       (set-buffer-modified-p (buffer-modified-p)) ;No-op, but updates mode line.
  142.       )
  143.       )
  144.     )
  145.   )
  146.  
  147. (defun module-name ()
  148.   (save-excursion
  149.     (goto-char (point-min))
  150.     (if (search-forward "module(" nil t)
  151.     (let ((module-start (point)))
  152.       (if (search-forward "," nil t)
  153.           (progn
  154.         (backward-char 1)
  155.         (buffer-substring module-start (point)))
  156.         (error "Ill formed module definition"))))))
  157.